#! /usr/bin/runghc
-- |
-- Module:        Hexena.
-- Stability:     Experimental
-- Portability:   Portable
--
-- <>
{-# LANGUAGE ForeignFunctionInterface #-}
module Hexena.Cmds.EntropyXPM (run) where

import Data.Array.Unboxed
import Data.Word
import qualified Data.ByteString.Lazy as L
import Foreign (Ptr, withForeignPtr)
import Foreign.C.String
import Graphics.UI.SDL
--import System.Environment (getArgs)

import Hexena.Math.Statistics
import Hexena.Text.DrawGraph

--extern "C" void writeXPM(SDL_Surface *surf, const char *fname) {
foreign import ccall unsafe "writeXPM" writeXPM :: Ptr SurfaceStruct -> CString -> IO ()

maxHeight :: Int
maxHeight = 64

displayHGraph :: String -> UArray Word8 Int -> UArray Word8 Int -> IO ()
displayHGraph f h1 h2 = withInit [InitVideo] $ do
  display <- setVideoMode 270 (2 * fromIntegral maxHeight) 32 []
  let disform = surfaceGetPixelFormat display
  setCaption f f
  _ <- fillRect display Nothing =<< mapRGB disform 0xff 0xff 0xff
  drawHist display 0x5555a3ff 0x000080ff 7 64 $ elems h1'
  drawHist display 0x55A555ff 0x006010ff 7 66 $ elems h2'
  -- let dL = drawHist display 0x870302fe 0xA70000A0
  -- dL 10 80 $ elems $ scaleHist h2 id
  -- dL 6 88 $ elems h1'
  Graphics.UI.SDL.flip display
  withForeignPtr display $ \s -> withCString (f ++ ".xpm") $ \fn -> writeXPM s fn
  evtloop NoEvent
    where evtloop Quit = return ()
          evtloop NoEvent = delay 0x200 >> waitEvent >>= evtloop
          evtloop (KeyDown (Keysym SDLK_ESCAPE _ _)) = return ()
          evtloop _ = pollEvent >>= evtloop
          h1' = scaleHist h1 id
          h2' = scaleHist h2 negate


{-main :: IO ()
main = do
  fname <- head `fmap` getArgs
  content <- L.unpack `fmap` L.readFile fname
  hist <- calcHist content
  histC <- calcHist $ rleBS content
  print $ calculateE hist
  print $ calculateE histC
  displayHGraph fname hist histC-}

run :: FilePath -> IO ()
run fn = do
  content <- L.unpack `fmap` L.readFile fn
  hist <- calcHist content
  histC <- calcHist $ rleBS content
  print $ calculateE hist
  print $ calculateE histC
  displayHGraph fn hist histC
